home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / x11 / rpg / crossfir.92 / crossfir / crossfire-0.92.5 / utils / gensym.pl < prev    next >
Perl Script  |  1996-07-24  |  2KB  |  88 lines
  1. package gensym;
  2.  
  3. # $Id: gensym.pl,v 1.1.1.1 1993/03/07 08:30:50 frankj Exp $
  4.  
  5. # Revision 1.7  1992/06/23  21:15:53  jmalcolm
  6. # Null out things instead of undef'ing them.
  7. #
  8. # Revision 1.6  1991/06/22  23:55:15  jmalcolm
  9. # changed order of nreturn's parameters.
  10. #
  11. # Revision 1.5  1991/06/22  23:45:21  jmalcolm
  12. # nget and nreturn now accept and keep track of
  13. # a function to print the gensym meaningfully.
  14. #
  15. # Revision 1.4  1991/05/31  10:56:23  jmalcolm
  16. # added nget and nreturn to enable more accurate tracking of
  17. # gensym use.
  18. #
  19. # Revision 1.3  1991/05/26  01:40:28  jmalcolm
  20. # fixed get. I had forgetten to change a variable
  21. # everywhere when I changed its name..
  22. #
  23. # Revision 1.2  1991/05/26  01:13:00  jmalcolm
  24. # added stats and returning gensyms.
  25. #
  26. # Revision 1.1  1991/05/26  00:23:55  jmalcolm
  27. # Initial revision
  28. #
  29.  
  30. $gensym = 'gensym0000000000000001';
  31. $totalout = 0;
  32. $totalin = 0;
  33. $totalcreated = 0;
  34. @list = ();
  35. %howtoprint = ();
  36.  
  37. sub stats {
  38.     ($totalout,$totalin,$totalcreated,$#list+1);
  39. }
  40.  
  41. sub nget {
  42.     local($useid,$printfunc) = @_;
  43.     $ind_out{$useid}++;
  44.     local($gs) = &get;
  45.     if ($_[1]) {
  46.         $howtoprint{$gs} = $printfunc;
  47.     }
  48.     $gs;
  49. }
  50.  
  51. sub nreturn {
  52.     local($gs,$useid) = @_;
  53.     $ind_in{$useid}++;
  54.     undef($howtoprint{$gs});
  55.     &return($gs);
  56. }
  57.  
  58. sub get {
  59.     local($gs);
  60.     ++$totalout;
  61.     if ($#list < 0) {
  62.         ++$gensym;
  63.         ++$totalcreated;
  64.         $gs = "gensyms'".$gensym;
  65.     } else {
  66.         $gs = shift(@list);
  67.     }
  68.     $gs;
  69. }
  70.  
  71. sub return {
  72.     ++$totalin;
  73.     local(*GS) = local($gs) = @_;
  74.     $GS = '';
  75.     %GS = @GS = ();
  76. #    undef($GS);
  77. #    undef(@GS);
  78. #    undef(%GS);
  79.     unshift(@list,$gs);
  80.     1;
  81. }
  82.  
  83. sub main'getgensym {    # old, deprecated interface
  84.     &get;
  85. }
  86.  
  87. 1;
  88.